unit uSysGlobal;

interface

uses windows, classes, sysutils, SyncObjs, ExtCtrls, Contnrs;

type

  TLogMsgType = (lmNormal, lmHint, lmWarning, lmError);

  TOnLog = procedure(const msg: string) of object;

  TSysGlobal = class
  private
    Flock: TCriticalSection;
    FGlobalIncID: integer;
    FOnLog: TOnLog;
    procedure Log(const msg: string; lm: TLogMsgType; ProcessDir: boolean = true);
  public
    constructor Create;
    destructor Destroy; override;
    procedure SysLockEnter;
    procedure SysLockLeave;
    function GlobalIncID: integer;
    property OnLog: TOnLog read FOnLog write FOnLog;
  end;

function InMainThread: boolean;

procedure CreateThreadMessageQueue;

procedure PrintLog(const Msg: string; lm: TLogMsgType = lmNormal);

procedure PrintModuleLog(const Msg: string; lm: TLogMsgType = lmNormal);

var
  SysGlobal         : TSysGlobal;

implementation

uses usysutils;

function InMainThread: boolean;
begin
  Result := GetCurrentThreadId = MainThreadID;
end;

procedure CreateThreadMessageQueue;
var
  msg               : TMsg;
begin
  PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE);
end;

procedure PrintLog(const Msg: string; lm: TLogMsgType = lmNormal);
begin
  SysGlobal.Log(Msg, lm);
end;

procedure PrintModuleLog(const Msg: string; lm: TLogMsgType = lmNormal);
begin
  SysGlobal.Log(msg, lm, false);
end;

{ TSysGlobal }

constructor TSysGlobal.Create;
begin
  Flock := TCriticalSection.Create;
end;

destructor TSysGlobal.Destroy;
begin
  Flock.Free;
  inherited;
end;

procedure TSysGlobal.SysLockEnter;
begin
  Flock.Enter;
end;

procedure TSysGlobal.SysLockLeave;
begin
  Flock.Leave;
end;

procedure TSysGlobal.Log(const msg: string; lm: TLogMsgType; ProcessDir: boolean = true);
var
  f                 : TextFile;
  filename, fDir    : string;
  Buffer            : array[0..260] of Char;
  logMsg            : string;
begin
  SysLockEnter;
  try
    if ProcessDir then
      fDir := ExtractFilePath(ParamStr(0)) + ExtractFileName(ParamStr(0)) + '.log\'
    else
    begin
      SetString(fDir, Buffer, GetModuleFileName(HInstance, Buffer, SizeOf(Buffer)));      
    end;  
    if not DirectoryExists(fDir) then
      ForceDirectories(fDir);
    filename := fDir + format('%s.log', [FormatDateTime('yyyy-MM-dd', now)]);
    AssignFile(f, FileName);
    try
      if FileExists(FileName) then
      begin
        Reset(f);
        Append(f);
      end
      else
        Rewrite(f);
      case lm of
        lmNormal: logMsg := StrFormat('[%s]: %s', [FormatDateTime('hh:mm:ss', now), msg]);
        lmHint: logMsg := StrFormat('[%s][hint]: %s', [FormatDateTime('hh:mm:ss', now), msg]);
        lmWarning: logMsg := StrFormat('[%s][warning]: %s', [FormatDateTime('hh:mm:ss', now), msg]);
        lmError: logMsg := StrFormat('[%s][error]: %s', [FormatDateTime('hh:mm:ss', now), msg]);
      end;            
      Writeln(f, logmsg);
      if Assigned(OnLog) then
        OnLog(logmsg);
    finally
      CloseFile(f);
    end;
  finally
    SysLockLeave;
  end;   
end;

function TSysGlobal.GlobalIncID: integer;
begin
  Result := InterlockedIncrement(FGlobalIncID);
end;

initialization
  SysGlobal := TSysGlobal.Create;
finalization
  SysGlobal.Free;

end.

